home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / ISSUE16 / SCRNSAV / TRANIMAG.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1997-04-17  |  1.8 KB  |  72 lines

  1. unit Tranimag;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, ExtCtrls;
  8.  
  9. type
  10.   TTranImage = class(TImage)
  11.   private
  12.     { Private declarations }
  13.     FTransColor :  TColor;
  14.     FTransparent:  Boolean;
  15.     procedure PaintImageTransparent(Image: TImage);
  16.   protected
  17.     { Protected declarations }
  18.     procedure Loaded; override;
  19.   public
  20.     { Public declarations }
  21.     constructor Create(AOwner : TComponent); override;
  22.   published
  23.     { Published declarations }
  24.     property TransColor:  TColor  read FTransColor  write FTransColor   default clSilver;
  25.     property Transparent: Boolean read FTransparent write FTransparent  default False;
  26.   end;
  27.  
  28. procedure Register;
  29.  
  30. implementation
  31.  
  32. procedure Register;
  33. begin
  34.   RegisterComponents('Additional', [TTranImage]);
  35. end;
  36.  
  37. constructor TTranImage.Create(AOwner: TComponent);
  38. begin
  39.   inherited Create(AOwner);
  40.   FTransColor := clSilver;
  41. end;
  42.  
  43. procedure TTranImage.Loaded;
  44. begin
  45.   inherited Loaded;    { always call the inherited Loaded first! }
  46.   if not (csDesigning in ComponentState) then
  47.   begin
  48.     PaintImageTransparent(Self);
  49.   end;
  50. end;
  51.  
  52. procedure TTranImage.PaintImageTransparent(Image: TImage);
  53. var
  54.   rect       : TRect;
  55.   color      : TColor;
  56. begin
  57.   if FTransparent and (Image.Picture <> nil) and (Image.Picture.Graphic is TBitmap) then
  58.     try
  59.       rect.Top       := 0;
  60.       rect.Left      := 0;
  61.       rect.Bottom    := Image.Picture.Bitmap.Height;
  62.       rect.Right     := Image.Picture.Bitmap.Width;
  63.  
  64.       Image.Canvas.Brush.Color :=  Image.Parent.Brush.Color;
  65.       {FTransColor := clSilver;}
  66.       Image.Canvas.BrushCopy(rect, Image.Picture.BitMap, rect, FTransColor);
  67.     except on E : Exception do
  68.     end;
  69. end;
  70.  
  71. end.
  72.